;;; $Id: telescope.sld 405 2014-03-06 04:33:08Z alan.watson.f $

(define-library (oaxaca telescope)

  (export telescope-offset!
          telescope-focus!)

  (import (scheme base)
          (scheme inexact)
          (scheme write))

  (import (oaxaca file)
          (oaxaca log))

  (begin

    (define telescope-file-path "/tmp/telescope")

    (define (display-offset offset width)
      (display (if (negative? offset) "-" "+"))
      (let ((abs-offset (exact (abs (round offset)))))
        (do ((i 1 (+ i 1)))
            ((= i width))
          (when (< abs-offset (expt 10 i))
            (display "0")))
        (display abs-offset)))

    (define (telescope-offset! east-offset north-offset)
      (when (>= (abs east-offset) 1000)
        (error "east-offset is too large" east-offset))
      (when (>= (abs north-offset) 1000)
        (error "north-offset is too large" north-offset))
      (when (file-exists? telescope-file-path)
        (delete-file telescope-file-path))
      (with-output-to-file telescope-file-path
        (lambda ()
          (display "MF")
          (display-offset (- east-offset) 3)
          (display-offset north-offset 3)
          (display ";\n")
          (flush-output-port)))
      (values))

    (define (telescope-focus! offset)
      (when (>= (abs offset) 10)
        (error "offset is too large" offset))
      (when (file-exists? telescope-file-path)
        (delete-file telescope-file-path))
      (with-output-to-file telescope-file-path
        (lambda ()
          (display "CF")
          (display-offset offset 1)
          (display ";\n")
          (flush-output-port)))
      (values))))
